home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tpldir.com / TPLDIR.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-01-23  |  3.1 KB  |  113 lines
  1. program TpLdir;
  2.   {-Program to emulate a TpDir that selects several filenames }
  3.  
  4. uses
  5.   TpCrt,                          {Crt interface, standard unit}
  6.   Dos,                            {Dos interface, standard unit}
  7.   TpPick;                         {Turbo Professional pick list manager}
  8.  
  9. type
  10.   Filepath                 = String[12]; {Type of returned filenames}
  11.   String13                 = String[13]; {Type of selected filenames (allows for #17)}
  12.  
  13. const
  14.   PMonoAttr                : PickColorArray = {Monochrome pick colors}
  15.   (
  16.     $07,
  17.     $0F,
  18.     $0F,
  19.     $70,
  20.     $0F,
  21.     $07
  22.     );
  23.  
  24.   PColorAttr               : PickColorArray = {Color pick colors}
  25.   (
  26.     $70,
  27.     $78,
  28.     $78,
  29.     $0F,
  30.     $71,
  31.     $1F
  32.     );
  33.   MaxFiles                 = 250; {Max file names}
  34.  
  35. var
  36.   FileStr                  : Filepath; {Entered filemask}
  37.   FileArr, ChosenArr       : array[1..MaxFiles] of Filepath; {File and select array}
  38.   PickColorArr             : PickColorArray; {Pick colors}
  39.   FileInfo                 : SearchRec; {For Find First/Next}
  40.   FileIndex,
  41.   SelectedFile,
  42.   ChosenFileIndex,                {Index variables}
  43.   ChosenIndex              : Word;
  44.  
  45.   {$F+}
  46.   function SendFileName(FileIndex : Word) : String13; {Return selected files}
  47.   begin
  48.     for ChosenIndex := 1 to MaxFiles do
  49.       if (FileArr[FileIndex] = ChosenArr[ChosenIndex]) then
  50.       begin
  51.         AltPickAttr := True;
  52.         SendFileName := FileArr[FileIndex]+#17;
  53.         Exit;
  54.       end;
  55.     SendFileName := FileArr[FileIndex];
  56.   end;
  57.   {$F-}
  58.  
  59.   procedure HaltError(msg : String); {Get out with an error}
  60.   begin
  61.     WriteLn(msg);
  62.     Halt(1);
  63.   end;
  64.  
  65. begin
  66.   TpWindow.Explode := False;      {No explode 'um}
  67.  
  68.   if WhichHerc = HercInColor then PickColorArr := PColorAttr
  69.   else
  70.     case CurrentMode of
  71.       2, 7 : PickColorArr := PMonoAttr;
  72.     else
  73.      PickColorArr := PColorAttr;
  74.     end;
  75.  
  76.   for ChosenIndex := 1 to MaxFiles do
  77.     ChosenArr[ChosenIndex][0] := #0;
  78.  
  79.   FileStr[0] := #0;
  80.   WriteLn('Enter a filemask to select from '); ReadLn(FileStr);
  81.   if Pos('*', FileStr)+Pos('?', FileStr) <> 0 then
  82.   begin
  83.     FileIndex := 0;
  84.     FindFirst(FileStr, Archive, FileInfo);
  85.     while DosError = 0 do
  86.     begin
  87.       Inc(FileIndex);
  88.       FileArr[FileIndex] := FileInfo.name;
  89.       FindNext(FileInfo);
  90.     end;
  91.     if FileIndex > 0 then
  92.     begin
  93.       SelectedFile := 1;
  94.       ChosenFileIndex := 0;
  95.       PickMatrix := 5;
  96.       if not AddPickCommand(PKSUser0, 1, 32, 0) then
  97.         HaltError('Error setting up command table');
  98.       repeat
  99.         if not PickWindow(@SendFileName, FileIndex, 1, 1, 78, 24,
  100.                           True, PickColorArr, FileStr, SelectedFile) then
  101.           HaltError('Error initializing pick list');
  102.         if PickCmdNum = PKSUser0 then
  103.         begin
  104.           Inc(ChosenFileIndex);
  105.           ChosenArr[ChosenFileIndex] := FileArr[SelectedFile];
  106.         end;
  107.       until (PickCmdNum = PKSExit) or (PickCmdNum = PKSSelect);
  108.       WriteLn('The files you chose were:');
  109.       for ChosenIndex := 1 to ChosenFileIndex do WriteLn(ChosenArr[ChosenIndex]);
  110.     end;
  111.   end;
  112. end.
  113.